home *** CD-ROM | disk | FTP | other *** search
/ Aminet 19 / Aminet 19 (1997)(GTI - Schatztruhe)[!][Jun 1997].iso / Aminet / comm / thor / HTMLThor.lha / HTMLThor.thor < prev    next >
Text File  |  1997-04-13  |  13KB  |  430 lines
  1. /*
  2. **   Filename: HTMLThor.thor
  3. **
  4. **   $VER: v1.48 (04.13.97)
  5. **
  6. **   Author:  Troy E. Bouchard
  7. **
  8. **   Copyright © 1997, Snowy Hill Solutions, All Rights Reserved.
  9. **
  10. **   EMail:   snowhill@eagle.@ptialaska.net
  11. **   Webpage: http://www.ptialaska.net/~tbouchar
  12. **
  13. **   See HTMLThor.guide for more info.
  14. */
  15.  
  16. tmp = 'T:http.tmp'
  17.  
  18. /* Find our Thor Port and number! */
  19. p = Address() || ' ' || show('P',,)
  20.     ThorPort = pos('THOR.',p)
  21. if ThorPort > 0 then ThorPort = word(substr(p,ThorPort),1)
  22. else
  23. do
  24.    say "Can't seem to find the Thor port!"
  25.    exit 10
  26. End
  27.  
  28. /* Load the BBSRead library up! */
  29. if ~show('p', 'BBSREAD') then
  30. do
  31.    address command
  32.    "run >nil: `GetEnv THOR/THORPath`bin/LoadBBSRead"
  33.    "WaitForPort BBSREAD"
  34. End
  35.  
  36. /* load in rexxsupport.library if it already isn't and it exists */
  37. if ~show(l,'rexxsupport.library') then do
  38.   if ~addlib("rexxsupport.library",0,-30,0) then do
  39.     say "Can't open rexxsupport.library"
  40.     exit
  41.   end
  42. end
  43.  
  44. options results
  45.  
  46. /* Change these to where you want the  */
  47. /* main.html and the #'rd.html's to go */
  48. /* Path for main.html */ HTMLPath = 'T:'
  49. /* Path for #'rd.html */ HTMLDir  = HTMLPath'digest'
  50.  
  51. if ~Exists(HTMLDir) then
  52.    call MakeDir(HTMLDir)
  53.  
  54. TB_EMail   = 'A HREF="mailto:'
  55.  
  56. /* change this to match your system! */
  57. TB_WWW       = 'A HREF="digest/'
  58.  
  59. TB_MSGPATH = HTMLPath
  60. TB_PATH    = HTMLDir'/'
  61.  
  62. EXT = '.html'  /* change this to .htm if you need to. */
  63.  
  64. /* aint ARexx just great? */
  65.  
  66. /* change these to your favorite language */
  67. /* Keep the order though! */
  68. TB_WDAYS = 'Monday Tuesday Wednesday Thursday Friday Saturday Sunday'
  69. TB_MONTH = 'January February March April May June July August September October November December'
  70.  
  71. MDF_DELETED      =  5     /* Message is deleted. */
  72. MDF_UNRECOVERABLE =  6     /* Message can not be undeleted. */
  73.  
  74. /* Remco; start */
  75. SIGNAL ON SYNTAX /* signal the SYNTAX procedure when a syntax error occurs */
  76. SIGNAL ON HALT     /* signal the HALT procedure when sys:rexxc/hi is run */
  77. /* Remco; end */
  78.  
  79. Call GetChoice
  80.  
  81. GetPages:
  82.    Address BBSREAD
  83.    'GETBBSLIST stem "'BBSLIST'"'
  84.    if(rc ~=0) then
  85.    do
  86.       Address(ThorPort)
  87.       'REQUESTNOTIFY TEXT "'BBSREAD.LASTERROR'" BT "_OK"'
  88.       call cleanup
  89.    End
  90.  
  91.    Address(ThorPort)
  92.    'REQUESTLIST instem "'BBSLIST'" outstem "'TB_SYSTEM'" title "Selection:" DRAGSELECT MULTISELECT SIZEGADGET'
  93.    if(rc ~= 0) then exit
  94.    do i=1 to TB_SYSTEM.COUNT
  95.       Address BBSREAD
  96.       'GETCONFLIST "'TB_SYSTEM.i'" CONFLIST'
  97.       if(rc ~= 0) then
  98.       do
  99.      Address(ThorPort)
  100.      'REQUESTNOTIFY TEXT "'BBSREAD.LASTERROR'" BT "_OK"'
  101.      call cleanup
  102.       End
  103.  
  104.       Address(ThorPort)
  105.       'REQUESTLIST instem "'CONFLIST'" title "Select conference on ' || TB_SYSTEM.i || ":" ||'" SIZEGADGET'
  106.       if(rc ~= 0) then TB_CONFNAME = ""
  107.       else TB_CONFNAME = result
  108.  
  109.       MyConf = Translate(TB_CONFNAME,," ","_")
  110.  
  111. /* Main HTML file */
  112.       call MainHTML
  113.  
  114.       Address BBSREAD
  115.       'GETCONFDATA BBSName "'TB_SYSTEM.i'" ConfName "'TB_CONFNAME'" Stem CDATA'
  116.       if(rc ~= 0) then
  117.       do
  118.      Address(ThorPort)
  119.      'REQUESTNOTIFY TEXT "'BBSREAD.LASTERROR'" BT "_OK"'
  120.      call cleanup
  121.       End
  122.  
  123.       Address(ThorPort)
  124.       'OPENPROGRESS TITLE " HTMLThor v1.48" PT "Getting Pages..." AT "_Abort" PCW 30'
  125.       if(rc ~= 0) then
  126.       do
  127.      'REQUESTNOTIFY TEXT "'THOR.LASTERROR'" BT "_OK"'
  128.      call cleanup
  129.       end
  130.       else win = result
  131.  
  132.       msgnumber = 0
  133.       do j = CDATA.FIRSTMSG to CDATA.LASTMSG
  134.      Drop MsgData.
  135.      Drop HeaderInfo.
  136.      Drop TextInfo.
  137.  
  138.      Address BBSREAD
  139.      'READBRMESSAGE "'TB_SYSTEM.i'" "'TB_CONFNAME'" MSGNR "'j'" DataStem "'MsgData'"'
  140.      if(rc ~= 0) then
  141.      do
  142.         Address(ThorPort)
  143.         'REQUESTNOTIFY TEXT "'BBSREAD.LASTERROR'" BT "_OK"'
  144.         call cleanup
  145.      end
  146.  
  147.      if (bittst(MsgData.FLAGS,MDF_DELETED) = 0 & bittst(MsgData.FLAGS, MDF_UNRECOVERABLE) = 0) then
  148.      do
  149.         msgnumber = msgnumber + 1
  150.         Address(ThorPort)
  151.         msgtext = 'Saving 'j 'as: 'TB_PATH||MyConf||msgnumber||EXT
  152.         'UPDATEPROGRESS REQ "'win'" TOTAL "'CDATA.NUMMESSAGES'" CURRENT "'msgnumber'" PT "'msgtext'"'
  153.         if(rc ~= 0) then do
  154.           call cleanup
  155.         end
  156.  
  157.         Address BBSREAD
  158.         'READBRMESSAGE "'TB_SYSTEM.i'" "'TB_CONFNAME'" MSGNR "'j'" TextStem "'TextInfo'" HeadStem "'HeaderInfo'"'
  159.         if(rc ~= 0) then
  160.         do
  161.            Address(ThorPort)
  162.            'REQUESTNOTIFY TEXT "'BBSREAD.LASTERROR'" BT "_OK"'
  163.            call Cleanup
  164.         end
  165.  
  166.         'AMIGA2DATE "'HeaderInfo.CREATIONDATE'" Stem "'Time'"'
  167.         if(rc ~= 0) then
  168.         do
  169.         NewTime = value('HeaderInfo.CREATIONDATETXT')
  170.         Say ''
  171.         Say 'OH NO!  CREATIONDATE IS SET TO TEXT!'
  172.         Say NewTime
  173.         Say 'Delete Message nr: 'j' and try again'
  174.         call Cleanup
  175.         end
  176.  
  177.         Call HeaderMSG
  178.  
  179.         call MainHTMLParts
  180.  
  181.         call MainConfHTML
  182.         call SelectMSG
  183.  
  184.         call writeln(out, '</CENTER><HR>')
  185.  
  186.         call MainConfTEXT
  187.         call SelectMSG
  188.  
  189.         call MainConfBottom
  190.      end
  191.       end
  192.       Call MainBottomHTML
  193.    end
  194.  
  195.    Address(ThorPort)
  196.    'REQUESTNOTIFY TEXT "    We Are Done!\nHTML Files Copied!" BT "_Cool!"'
  197.    'CLOSEPROGRESS REQ' win
  198.    Call DelMSGS
  199.  
  200. SYNTAX:
  201.   SAY 'SYNTAX ERROR'
  202.   SAY 'Error 'rc' in line 'sigl': 'errortext(rc)
  203. HALT:
  204. cleanup:
  205.  IF (win ~= 0) & SYMBOL('win') = 'VAR' THEN DO
  206.    ADDRESS(thorport)
  207.    'CLOSEPROGRESS REQ' win
  208.  END
  209. EXIT
  210.  
  211. MainHTML:
  212.    call open(out, TB_MSGPATH||MyConf||EXT, w)
  213.    call writeln(out, '<HTML><HEAD>')
  214.    call writeln(out, '<TITLE>'MyConf'</TITLE>')
  215.    call MetaGEN
  216.    call writeln(out, '</HEAD>')
  217.    call writeln(out, '<BODY><B><PRE><CENTER><H1>Articles in 'MyConf'</B></H1></CENTER><HR>')
  218.    call close(out)
  219. Return
  220.  
  221. MainConfHTML:
  222.    call open(out, TB_PATH || MyConf || msgnumber || EXT, w)
  223.    call writeln(out, '<HTML><HEAD>')
  224.    call writeln(out, '<TITLE>'MyConf||' - 'Subj||'</TITLE>')
  225.    call MetaGEN
  226.    call writeln(out, '</HEAD>')
  227.    call writeln(out, '<BODY><H2><B><CENTER>'MyConf||'</H2>')
  228.    call writeln(out, 'Message posted on:<BR>')
  229.    call writeln(out, WKDays' 'MODays' 'Time.MDAY', 'Time.YEAR'</B>')
  230.    call writeln(out, '<PRE><HR><B>From:</B>  'Nom'  ('Addr')<BR><B>Subject:</B>  'Subj||'')
  231.    call writeln(out, '<B>Message Nr.</B> 'j' (from Database)</PRE></CENTER>')
  232. Return
  233.  
  234. MainConfTEXT:
  235.    cnt = value('TextInfo.TEXT.COUNT')
  236.  
  237.    if(cnt = 0) then call writeln(out,'No Text<BR>')
  238.       else
  239.       do
  240.      do n = 1 to cnt
  241.         call writeln(out, value('TextInfo.TEXT.n')'<BR>')
  242.      end
  243.       end
  244. Return
  245.  
  246. /* figure out what goes where.    First,Last,Next,Prev */
  247. SelectMSG:
  248.    NextMSG = msgnumber + 1
  249.    PrevMSG = msgnumber - 1
  250.  
  251.    SELECT
  252.      When PrevMSG = 0 then call writeln(out,'<HR><CENTER><A HREF="'MyConf||CDATA.NUMMESSAGES||EXT'"><IMG BORDER=0 SRC="last.gif" ALT="| Last |"></A><A HREF="'MyConf||NextMSG||EXT'"><IMG BORDER=0 SRC="next.gif" ALT=" Next |"></A>')
  253.      When NextMSG > CDATA.NUMMESSAGES then call writeln(out,'<HR><CENTER><A HREF="'MyConf||PrevMSG||EXT'"><IMG BORDER=0 SRC="previous.gif" ALT="| Prev |"></A><A HREF="'MyConf||'1'||EXT'"><IMG BORDER=0 SRC="first.gif" ALT=" First |"></A>')
  254.      OTHERWISE call writeln(out, '<HR><CENTER><A HREF="'MyConf||PrevMSG||EXT'"><IMG BORDER=0 SRC="previous.gif" ALT=" | Prev |"></A><A HREF="'MyConf||NextMSG||EXT'"><IMG BORDER=0 SRC="next.gif" ALT=" Next |"></A>')
  255.    End
  256. Return
  257.  
  258. MainConfBottom:
  259.    call writeln(out,'<HR><B>Output created by HTMLThor v1.48<BR>')
  260.    call writeln(out,'Written by: Troy E. Bouchard, © 1997</B>')
  261.    call writeln(out,'<HR></BODY></HTML></CENTER>')
  262.    call close(out)
  263. Return
  264.  
  265. MainHTMLParts:
  266.    call open(out, TB_MSGPATH||MyConf||EXT, a)
  267.    call writeln(out,'<B>From:      </B><'TB_EMail||Addr'">'||Nom'</A>')
  268.    call writeln(out,'<B>Subject:   </B><'TB_WWW||MyConf||msgnumber||EXT'">'Subj||'</A><HR>')
  269.    call close(out)
  270. Return
  271.  
  272. MainBottomHTML:
  273.    call open(out, TB_MSGPATH||MyConf||EXT, a)
  274. /* Please do not change anything here! */
  275.    call writeln(out,'<B><CENTER>Output created by HTMLThor v1.48')
  276.    call writeln(out,'Written by: Troy E. Bouchard, © 1997</B></CENTER>')
  277.    call writeln(out,'<HR></BODY></HTML>')
  278.    call close(out)
  279. Return
  280.  
  281. MetaGEN:
  282. /* Please do not change anything here! */
  283.    call writeln(out, '<!--- Please Do Not Change These! --->')
  284.    call writeln(out, '<META NAME="GENERATOR" CONTENT="HTMLThor v1.48 © 04.12.97 Troy E. Bouchard EMail: tbouchar@ptialaska.net">')
  285.    call writeln(out, '<META NAME="DESCRIPTION" CONTENT="Thor Conference: 'MyConf' - This program was written by Troy E. Bouchard for the Amiga.  You can download it from Aminet or you can EMail me for it.">')
  286.    call writeln(out, '<META NAME="KEYWORDS" CONTENT="HTMLThor, Amiga, www, Bouchard, Thor">')
  287. Return
  288.  
  289. GetChoice:
  290.   'REQUESTNOTIFY TEXT "What to convert!?" BT "_Conference?|_Message!|_Stop!"'
  291.    if(result = 0) then Call Cleanup
  292.    if(result = 1) then Call GetPages
  293.    if(result = 2) then Call GetMsg
  294. Return
  295.  
  296. GetMsg:
  297.    Address(ThorPort)
  298.       'CURRENTMSG stem "'MSG'"'
  299.       if(rc ~= 0) then
  300.       do
  301.      Address(ThorPort)
  302.      'REQUESTNOTIFY TEXT "'THOR.LASTERROR'" BT "_OK"'
  303.      call Cleanup
  304.       end
  305.  
  306.    Address BBSREAD
  307.       'GETBBSDATA BBSName "'MSG.BBSNAME'" stem "'BBSDATA'"'
  308.       if(rc ~= 0) then
  309.       do
  310.      Address(ThorPort)
  311.      'REQUESTNOTIFY TEXT "'BBSREAD.LASTERROR'" BT "_OK"'
  312.      call Cleanup
  313.       end
  314.  
  315.    Drop HeaderInfo.
  316.    Drop TextInfo.
  317.  
  318.    Address BBSREAD
  319.       'READBRMESSAGE "'MSG.BBSNAME'" "'MSG.CONFNAME'" MSGNR "'MSG.MSGNR'" TextStem "'TextInfo'" HeadStem "'HeaderInfo'"'
  320.       if(rc ~= 0) then
  321.       do
  322.      Address(ThorPort)
  323.      'REQUESTNOTIFY TEXT "'BBSREAD.LASTERROR'" BT "_OK"'
  324.      call Cleanup
  325.       end
  326.  
  327.    Address BBSREAD
  328.       'AMIGA2DATE "'HeaderInfo.CREATIONDATE'" Stem "'Time'"'
  329.       if(rc ~= 0) then
  330.       do
  331.      Address(ThorPort)
  332.      'REQUESTNOTIFY TEXT "'BBSREAD.LASTERROR'" BT "_OK"'
  333.      call Cleanup
  334.       end
  335.  
  336.       Call HeaderMSG
  337.  
  338.       Call Open out, TB_MSGPATH||MSG.CONFNAME'.'MSG.MSGNR||EXT, w
  339.       Call WriteLN out,'<HTML><HEADER>'
  340.       Call WriteLN out, '<!--- Please Do Not Change These! --->'
  341.       Call WriteLN out, '<META NAME="GENERATOR" CONTENT="HTMLThor v1.48 © 04.12.97 Troy E. Bouchard EMail: tbouchar@ptialaska.net">'
  342.       Call WriteLN out, '<META NAME="DESCRIPTION" CONTENT="Thor Conference: 'MSG.CONFNAME' - This program was written by Troy E. Bouchard.  You can download it from Aminet or you can EMail me for it.">'
  343.       Call WriteLN out, '<META NAME="KEYWORDS" CONTENT="HTMLThor, www, Bouchard, Thor">'
  344.       Call Writeln out, '<TITLE>System: 'BBSDATA.NAME || ' ' || '('MSG.CONFNAME')</TITLE>'
  345.       Call WriteLN out, '</HEADER>'
  346.       Call Close out
  347.  
  348.       Call Open out, TB_MSGPATH||MSG.CONFNAME'.'MSG.MSGNR||EXT, a
  349.  
  350.       Call WriteLN out, '<BODY><CENTER><B><H2>Date: </B>'WKDays || ' ' || MODays || ' ' || Time.MDAY || ', ' || Time.YEAR || '<BR>'
  351.       Call WriteLN out, '<B>From: </B><'TB_EMail || Addr'">'Nom'</A><BR>'
  352.       Call WriteLN out, '<B>To:   </B>'ToNom || ' ' || '<'ToAdd'><BR>'
  353.       Call WriteLN out, '<B>Subj: </B>'Subj '</H2></CENTER><HR>'
  354.  
  355.       Call MainConfText
  356.       Call WriteLN out, '<CENTER>'
  357.       Call MainConfBottom
  358.  
  359.      Address(ThorPort)
  360.      'REQUESTNOTIFY TEXT "Message Copied!" BT "_Stop IT!"'
  361. Return
  362.  
  363. HeaderMSG:
  364.       if(Time.WDAY == '0') then
  365.      WKDays = 'Sunday'
  366.       else
  367.      WKDays = word(TB_WDAYS, Time.WDAY)
  368.      MODays = word(TB_MONTH, Time.MONTH)
  369.  
  370.       if symbol('HeaderInfo.FROMADDR') = "VAR" then
  371.      Addr = value('HeaderInfo.FROMADDR')
  372.  
  373.       if symbol('HeaderInfo.FROMNAME') = "VAR" then
  374.      Nom = value('HeaderInfo.FROMNAME')
  375.  
  376.       if symbol('HeaderInfo.SUBJECT') = "VAR" then
  377.      Subj = value('HeaderInfo.SUBJECT')
  378.  
  379.       if symbol('HeaderInfo.TONAME') = "VAR" then
  380.       ToNom = value('HeaderInfo.TONAME')
  381.  
  382.       if symbol('HeaderInfo.TOADDR') = "VAR" then
  383.      ToAdd = value('HeaderInfo.TOADDR')
  384. Return
  385.  
  386. DelMSGS:
  387.    if (bittst(MsgData.FLAGS,MDF_DELETED) = 0 & bittst(MsgData.FLAGS, MDF_UNRECOVERABLE) = 0) then
  388.    do
  389.       Address(ThorPort)
  390.       'REQUESTNOTIFY TEXT "Delete Messages in\nConfernce 'TB_CONFNAME'?" BT "_NO|_OK"'
  391.       if(rc ~= 0) then
  392.       do
  393.      'REQUESTNOTIFY TEXT "'THOR.LASTERROR'" BT "_OK"'
  394.      Call Cleanup
  395.       End
  396.  
  397.       if(result = 0) then Call DelProgress
  398.       if(result = 1) then Call Cleanup
  399.    End
  400.  
  401.    'REQUESTNOTIFY TEXT "No messages to Delete!" BT "_OK"'
  402. Call Cleanup
  403.  
  404. DelProgress:
  405.    'CURRENTSYSTEM stem "'TB_SYS'"'
  406.  
  407.    'OPENPROGRESS TITLE "Deleting messages" PT "Getting messages..." AT "_Abort" PCW 30'
  408.    if(rc = 0) then
  409.    do
  410.      win = result
  411.      do d=CDATA.FIRSTMSG to CDATA.LASTMSG
  412.     Address(ThorPort)
  413.     'UPDATEPROGRESS REQ "'win'" TOTAL "'CDATA.NUMMESSAGES'" CURRENT "'d-CDATA.FIRSTMSG+1'" PT "Deleting message # 'd'" '
  414.     if(rc ~= 0) then
  415.     do
  416.        'REQUESTNOTIFY TEXT "'THOR.LASTERROR'" BT "_OK"'
  417.        Call Cleanup
  418.     end
  419.  
  420.     Address(BBSRead)
  421.     'UPDATEBRMESSAGE "'TB_SYS.BBSNAME'" "'TB_CONFNAME'" "'d'" SETDELETED'
  422.     if(rc ~= 0) then
  423.     do
  424.        'REQUESTNOTIFY TEXT "'BBSREAD.LASTERROR'" BT "_OK"'
  425.        Call Cleanup
  426.     end
  427.      end
  428.    end
  429. Call Cleanup
  430.